perm filename PAKMSS.F4[MSS,LCS] blob
sn#155845 filedate 1975-04-18 generic text, type T, neo UTF8
00100 C TO PUT .DAT MSS FILES TOGETHER AND TAKE APART. LOAD WITH MSFAIL
00200 DIMENSION SV(127)
00300 COMMON V(78),ISCR,LCNT,LIST(200) ,RN(2100)
00400 1 ,RSTFAC(8),NM,STFF(8),ITEM,I,PWDS(250)
00500 EQUIVALENCE (SV,RN)
00600 GO=0
00700 TYPE 1
00800 1 FORMAT(' PACK, UNPACK, ADD TO? -- '$)
00850 C TYPE 'L' TO ONLY LIST NAMES IN PACKED FILE.
00900 ACCEPT 2,K
01000 2 FORMAT(A1)
01100 IF(K.EQ.'P')GO TO 3
01150 IF(K.EQ.'A')TYPE 527
01200 6 TYPE 20
01300 ACCEPT 21,NAME
01400 NN=1
01420 IF(K.EQ.'L')GO TO 627
01500 IF(K.NE.'A')GO TO 127
01600 227 TYPE 26
01700 ACCEPT 21,NOUT
01800 IF(NAME.EQ.NOUT)GO TO 227
01900 TYPE 327
02000 327 FORMAT(' ADD FILE')
02050 527 FORMAT(' INPUT')
02100 TYPE 20
02200 GO TO 427
02220 627 NZ=' '
02260 GO TO 727
02300
02400 127 TYPE 27
02500 27 FORMAT(' GET WHICH FILE? '$)
02600 427 ACCEPT 21,NZ,N
02700 C BLANK NAME GETS ALL ON FILE. NAME, NUM. GETS THAT NUM OF FILES.
02800 IF(NZ.EQ.'ALL')NZ=' '
02900 IF(NZ.EQ.' ')N=999
03000 C BLANK GETS ALL
03100 727 CALL GETFI2(NAME)
03200 IF(K.EQ.'A')GO TO 126
03300 90 CALL FASTI2(RSTFAC,21)
03400 IF(NM.NE.-999)GO TO 91
03500 IF(K.NE.'A')CALL EXIT
03600 C NOW GO ADD THE FILES
03700 NAME=NZ
03800 K='P'
03900 GO TO 200
04000 91 CALL FASTI2(RN,I)
04100 L=ITEM+1
04200 CALL FASTI2(PWDS,L)
04300 NAME=NM
04400 IF(K.EQ.'A')GO TO 311
04500 IF(NZ.EQ.' ')GO TO 311
04600 IF(NZ.NE.NAME)GO TO 90
04700 C SEARCH FOR A PARTICULAR NAME.
04800 311 TYPE 10,NAME
04850 IF(K.EQ.'L')GO TO 90
04900 IF(K.EQ.'A')GO TO 131
05000 IF(LOOKD(NAME).GE.0)GO TO 102
05100 IF(GO.EQ.'G')GO TO 104
05200 TYPE 101
05300 ACCEPT 2,GO
05400 C ANSWER 'G' (FOR GO) TO REPLACE ALL! BE CAREFUL!!!
05500 IF(GO.NE.'N')GO TO 102
05600 C IF 'NO' GO BACK FOR NEXT FILE
05700 TYPE 103
05800 ACCEPT 21,NAME
05900 IF(NAME.EQ.' ')GO TO 90
06000 GO TO 102
06100 103 FORMAT(' TYPE NEW NAME -- '$)
06200 105 FORMAT(' REPLACED')
06300 104 TYPE 105
06400 102 REWIND 1
06500 CALL OFILE(1,NAME)
06600 11 ISCR=1
06700 LIST(1)=0
06800 C CLEARS MOTIVE LIST
06900 WRITE(1)ITEM,I,(PWDS(L),L=1,ITEM+1),(RN(L),L=1,I-1),ISCR,V(1),
07000 1 ISCR,LIST(1),RSTFAC,STFF,NM,SV
07100 WRITE(1)RSTFAC,STFF,NM,L,L,L
07200 8 END FILE 1
07300 NN=NN+1
07400 NZ=' '
07500 IF(NN.LE.N)GO TO 90
07600 CALL EXIT
07700
07800 3 TYPE 26
07900 26 FORMAT(' TYPE OUTPUT FILE NAME -- '$)
08000 ACCEPT 21,NOUT
08100 126 IF(LOOKF(NOUT).GE.0)GO TO 100
08150 TYPE 10,NOUT
08200 TYPE 101
08300 101 FORMAT(' WRITE OVER THIS FILE? '$)
08400 ACCEPT 2,L
08500 IF(L.EQ.'N')GO TO 3
08600 100 CALL PUTFIL(NOUT)
08700 IF(K.EQ.'A')GO TO 90
08800 25 TYPE 20
08900 20 FORMAT(' TYPE FILE NAME -- '$)
09000 ACCEPT 21,NAME,N
09100 C N IS FOR HOW MANY FILES. 0=999. IF NAME IS <5 LETTERS MUST USE N.
09200 200 NMZ=NAME
09300 IF(NAME.EQ.' ')GO TO 30
09400 NN=1
09500 IF(N.EQ.0)N=999
09600 C WILL READ ALL IT CAN FIND.
09700 21 FORMAT(A5,I)
09800 23 IF(LOOKD(NAME))GO TO 221
09900 C JUMP IF IT FOUND IT.
10000 TYPE 24
10100 24 FORMAT(' FILE NOT FOUND'/)
10200 GO TO 25
10300
10400 22 IF(LOOKD(NAME).GE.0)GO TO 25
10500 221 NM=NAME
10600 4 REWIND 21
10700 CALL IFILE(21,NAME)
10800 7 NMX=NAME
10900 9 READ(21,END=30)ITEM,I
11000 1,(PWDS(L),L=1,ITEM+1),(RN(L),L=1,I-1),ISCR,(V(L),L=1,ISCR),
11100 1 LCNT,(LIST(L),L=1,LCNT),RSTFAC,STFF,NAME
11200 READ(21,END=31)RSTFAC,STFF
11300 10 FORMAT(1XA5)
11400 31 TYPE 10,NMX
11500 NM=NMX
11600 131 CALL FASTOU(RSTFAC,21)
11700 CALL FASTOU(RN,I)
11800 ITEM=ITEM+1
11900 CALL FASTOU(PWDS,ITEM)
12000 IF(K.EQ.'A')GO TO 90
12100 IF(NN.GE.N)GO TO 25
12200
12300 5 NN=NN+1
12400 NAME=NMX
12500 NAME=NAME+2
12600 C GOES UP THE ALPHABET
12700 IF(LOOKD(NAME))GO TO 221
12800 NAME=NMZ+256
12900 NMZ=NAME
13000 GO TO 22
13100 30 IF(K.EQ.'U')CALL EXIT
13200 NM=-999
13300 CALL FASTOU(RSTFAC,21)
13400 CALL FINFIL
13500 END